home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Visualicio47132182002.psc / File Information.bas < prev    next >
Encoding:
BASIC Source File  |  2002-01-03  |  4.3 KB  |  179 lines
  1. Attribute VB_Name = "modFileInfo"
  2. Global counter As Integer
  3. Public Function NullPad(strData As String) As String
  4.  
  5. If strData = "" Then Exit Function
  6. Dim lenData As Long
  7.  
  8. For i = 1 To Len(strData)
  9.     tempStr = tempStr & Chr(0) & Mid(strData, i, 1)
  10. Next
  11.  
  12. NullPad = Chr(1) & tempStr
  13.  
  14.  
  15. End Function
  16. Public Function ReplaceIt(Original As Variant, Item As String, Replace As String) As String
  17.  
  18. If InStr(Original, Item) = False Then
  19.     ReplaceIt = Original
  20.     Exit Function
  21. End If
  22.  
  23. nStage$ = Original
  24. Do Until InStr(nStage$, Item) = 0
  25.     lSide$ = Left$(nStage$, InStr(nStage$, Item) - 1)
  26.     rSide$ = Right$(nStage$, (Len(nStage$) - Len(lSide$) - Len(Item)))
  27.     nStage$ = lSide$ & Replace & rSide$
  28. Loop
  29. ReplaceIt = nStage$
  30.  
  31.  
  32. End Function
  33. 'keep
  34. Public Function GetCompanyName(strFile As String)
  35.  
  36. Dim tempFile As String
  37. Dim pos As Long
  38. Dim StartPos As Long, EndPos As Long
  39.  
  40. fileText$ = "CompanyName"
  41. nextText$ = "FileDescription"
  42.  
  43. Open strFile For Binary As #1
  44.     tempFile = Space(LOF(1))
  45.     Get #1, , tempFile
  46. Close #1
  47.  
  48. pos = InStr(tempFile, NullPad("StringFileInfo"))
  49.  
  50. If pos = 0 Then
  51.     pos = InStr(tempFile, "StringFileInfo")
  52.     If pos = 0 Then pos = 1
  53.     pnStart = InStr(pos, tempFile, fileText$)
  54.     fileLength% = 12
  55. Else
  56.     pnStart = InStr(pos, tempFile, NullPad(fileText$))
  57.     nextText$ = NullPad(nextText$)
  58.     fileLength% = 26
  59. End If
  60.  
  61. If pnStart > 0 Then
  62.     StartPos = pnStart + fileLength%
  63.     EndPos = InStr(StartPos, tempFile, String(3, Chr(0)))
  64.     
  65.     If InStr(Mid(tempFile, StartPos, EndPos - StartPos), nextText$) <> 0 Then
  66.         For i = 1 To 255
  67.             If CInt(Asc(Mid(tempFile, StartPos + i, 1))) <= 31 Then
  68.                 EndPos = StartPos + (i - 1)
  69.                 Exit For
  70.             End If
  71.         Next i
  72.         counter = counter + 1
  73.     End If
  74.     
  75.     FileInfo = Mid(tempFile, StartPos, EndPos - StartPos)
  76.     GetCompanyName = ReplaceIt(FileInfo, Chr(0), "")
  77. End If
  78.  
  79.  
  80. End Function
  81. 'keep
  82. Public Function GetFileDescription(strFile As String)
  83.  
  84. Dim tempFile As String
  85. Dim pos As Long
  86. Dim StartPos As Long, EndPos As Long
  87.  
  88. fileText$ = "FileDescription"
  89. nextText$ = "FileVersion"
  90.  
  91. Open strFile For Binary As #1
  92.     tempFile = Space(LOF(1))
  93.     Get #1, , tempFile
  94. Close #1
  95.  
  96. pos = InStr(tempFile, NullPad("StringFileInfo"))
  97.  
  98. If pos = 0 Then
  99.     pos = InStr(tempFile, "StringFileInfo")
  100.     If pos = 0 Then pos = 1
  101.     pnStart = InStr(pos, tempFile, fileText$)
  102.     fileLength% = 16
  103. Else
  104.     pnStart = InStr(pos, tempFile, NullPad(fileText$))
  105.     nextText$ = NullPad(nextText$)
  106.     fileLength% = 34
  107. End If
  108.  
  109. If pnStart > 0 Then
  110.     StartPos = pnStart + fileLength%
  111.     EndPos = InStr(StartPos, tempFile, String(3, Chr(0)))
  112.     
  113.     If InStr(Mid(tempFile, StartPos, EndPos - StartPos), nextText$) <> 0 Then
  114.         For i = 1 To 255
  115.             If CInt(Asc(Mid(tempFile, StartPos + i, 1))) <= 31 Then
  116.                 EndPos = StartPos + i
  117.                 Exit For
  118.             End If
  119.         Next i
  120.         counter = counter + 1
  121.     End If
  122.     
  123.     FileInfo = Mid(tempFile, StartPos, EndPos - StartPos)
  124.     GetFileDescription = ReplaceIt(FileInfo, Chr(0), "")
  125. End If
  126.  
  127.  
  128. End Function
  129.  
  130. 'keep
  131. Public Function GetProductName(strFile As String)
  132.  
  133. Dim tempFile As String
  134. Dim pos As Long
  135. Dim StartPos As Long, EndPos As Long
  136.  
  137. fileText$ = "ProductName"
  138. nextText$ = "ProductVersion"
  139.  
  140. Open strFile For Binary As #1
  141.     tempFile = Space(LOF(1))
  142.     Get #1, , tempFile
  143. Close #1
  144.  
  145. pos = InStr(tempFile, NullPad("StringFileInfo"))
  146.  
  147. If pos = 0 Then
  148.     pos = InStr(tempFile, "StringFileInfo")
  149.     If pos = 0 Then pos = 1
  150.     pnStart = InStr(pos, tempFile, fileText$)
  151.     fileLength% = 12
  152. Else
  153.     pnStart = InStr(pos, tempFile, NullPad(fileText$))
  154.     fileLength% = 26
  155. End If
  156.  
  157. If pnStart > 0 Then
  158.     StartPos = pnStart + fileLength%
  159.     EndPos = InStr(StartPos, tempFile, String(3, Chr(0)))
  160.     
  161.     If InStr(Mid(tempFile, StartPos, EndPos - StartPos), nextText$) <> 0 Then
  162.         For i = 1 To 255
  163.             If CInt(Asc(Mid(tempFile, StartPos + i, 1))) <= 31 Then
  164.                 EndPos = StartPos + (i - 1)
  165.                 Exit For
  166.             End If
  167.         Next i
  168.         counter = counter + 1
  169.     End If
  170.     
  171.     FileInfo = Mid(tempFile, StartPos, EndPos - StartPos)
  172.     GetProductName = ReplaceIt(FileInfo, Chr(0), "")
  173. End If
  174.  
  175.  
  176. End Function
  177.  
  178.    
  179.